home *** CD-ROM | disk | FTP | other *** search
/ Softdisk Supreme / Softdisk Supreme.iso / pc / DSK Files / 0-49 / SD023b.dsk / F.bas < prev    next >
BASIC Source File  |  2003-06-12  |  6KB  |  85 lines
  1. 10  TEXT : HOME : LOMEM: 24576
  2. 15  VTAB 5: PRINT "DO YOU WISH TO SEE THE INSTRUCTIONS? N";: HTAB 38: GET A$: PRINT A$: IF A$ = "Y"  THEN  GOSUB 20000
  3. 18  HOME : PRINT "LET'S START THE GAME": VTAB 5
  4. 20  PRINT  CHR$(4)"BLOAD CARD.SHPS,A$4000": POKE 232,0: POKE 233,64
  5. 30  DIM D(52),DK(52),V(35),S(35),X(42),Y(42),C$(13):L = 768:A1 = 8:A2 = 21:A3 = 27:A4 = 47:A5 = 32:A6 = 58: SCALE= 1: ROT= 0:CU = 1
  6. 40  GOSUB 30000
  7. 50  HTAB 14: PRINT " SHUFFLING "
  8. 220 R =  RND( -( RND(1) ^2))
  9. 230  FOR C = 1 TO 52
  10. 235 R =  INT(52 * RND(1) +1): IF R = C  THEN 235
  11. 240 RT = DK(C):DK(C) = DK(R):DK(R) = RT:D(C) = DK(C):D(R) = DK(R)
  12. 250  PRINT  SPC( C)"*";: CALL 768
  13. 260  NEXT : FOR P = 1 TO 500: NEXT : PRINT : HOME 
  14. 270  POKE 34,20: HOME : HGR : HCOLOR= 6: HPLOT 0,0 TO 0,159 TO 268,159 TO 268,0 TO 2,0 TO 2,158 TO 266,158 TO 266,1 TO 2,1: FOR C = 1 TO 35:V(C) = D(C):D(C) = 0
  15. 280 S(C) = 14
  16. 290  IF V(C) >13  THEN S(C) = S(C) +1:V(C) = V(C) -13: GOTO 290
  17. 300 I = C
  18. 310  GOSUB 5000: NEXT : GOSUB 7000
  19. 320 C = 0: IF D(52) = 0  THEN 400: REM DEAL A CARD
  20. 330 C = C +1:C1 = 52 -C: IF D(C) = 0  THEN 330
  21. 340 I = 0:S(I) = 14
  22. 350 V(I) = D(C):D(C) = 0
  23. 360 S(I) = S(I) + INT((V(I) -1)/13):V(I) = V(I) -13 *(S(I) -14)
  24. 370  GOSUB 5000
  25. 400  IF C1 = 0  THEN  GOSUB 9500
  26. 405  HTAB 1: VTAB 21: PRINT "[<- ->] MOVE POINTER       [ESC] = QUIT": PRINT "[SPACE] PLAY CARD TO OUTPUT FILE        [1-9-0] PLAY CARD FROM DECK": PRINT  SPC( 7)"THE DECK HAS ";: INVERSE : PRINT C1;: NORMAL : PRINT " CARDS LEFT ";
  27. 410  POKE 49168,0
  28. 420  WAIT 49152,128
  29. 430 A =  PEEK(49152) -128: POKE 49168,0
  30. 440  IF A >A4  AND A <A6  THEN  HTAB 1: GOTO 320
  31. 450  IF A = A3  THEN  HOME : GOTO 6000: REM QUIT ROUTINE
  32. 460  IF A = A1  AND CU < >1  THEN OC = CU:CU = CU -1: GOSUB 7500: GOSUB 7000: GOTO 400
  33. 470  IF A = A2  AND CU < >7  THEN OC = CU:CU = CU +1: GOSUB 7500: GOSUB 7000: GOTO 400
  34. 480  IF A = A1  AND CU = 1  THEN OC = CU:CU = CU +6: GOSUB 7500: GOSUB 7000: GOTO 400
  35. 490  IF A = A2  AND CU = 7  THEN OC = CU:CU = CU -6: GOSUB 7500: GOSUB 7000: GOTO 400
  36. 500  IF A < >A5  THEN  HOME : PRINT : PRINT "<CTRL-G>        YOU GOOFED - TRY AGAIN<CTRL-G>": FOR P = 1 TO 2000: NEXT : GOTO 400
  37. 510  IF V(CU) = 0  THEN  HOME : PRINT "<CTRL-G>THERE ARE NO CARDS HERE!<CTRL-G>": FOR P = 1 TO 3000: NEXT : GOTO 400
  38. 520 J = 28
  39. 530  IF V(J +CU) < >0  THEN I = J +CU:II = I -7: GOTO 600
  40. 540  IF J >7  THEN J = J -7: GOTO 530
  41. 560 I = CU
  42. 570  IF (V(I) = V(0) +1)  OR (V(I) = V(0) -1)  THEN  HCOLOR= 4: DRAW 18 AT X(I),Y(I):V(0) = V(I):V(I) = 0:S(0) = S(I):S(I) = 0:I = 0: GOSUB 5000: GOTO 9000
  43. 580  GOTO 8000
  44. 600  IF (V(I) = V(0) +1)  OR (V(I) = V(0) -1)  THEN  HCOLOR= 4: DRAW 18 AT X(I),Y(I): HCOLOR= 7: DRAW S(II) +5 AT X(I),Y(I):V(0) = V(I):V(I) = 0:S(0) = S(I):S(I) = 0:I = 0: GOSUB 5000: GOTO 9000
  45. 610  GOTO 8000
  46. 4999  END 
  47. 5000  POKE 783,100: HCOLOR= 7: DRAW 18 AT X(I),Y(I): HCOLOR= 4: DRAW V(I) AT X(I) +5,Y(I) +5: CALL L
  48. 5010  IF S(I) = 14  OR S(I) = 15  THEN  HCOLOR= 4
  49. 5020  IF S(I) = 16  OR S(I) = 17  THEN  HCOLOR= 5
  50. 5030  DRAW S(I) AT X(I) +12,Y(I) +25: RETURN 
  51. 6000  VTAB 22: PRINT "GIVE UP ON THIS HAND?  ";: GET A$: PRINT A$: IF A$ < >"Y"  AND A$ < >"N"  THEN 6000
  52. 6010  IF A$ = "N"  THEN 400
  53. 6020  HOME 
  54. 6025  VTAB 24: PRINT "DO YOU WANT TO TRY AGAIN? ";: POKE 49168,0
  55. 6028  GET A$: IF A$ < >"Y"  AND A$ < >"N"  THEN 6028
  56. 6030  PRINT A$: IF A$ = "Y"  THEN  HGR : TEXT : HOME : GOTO 50
  57. 6050  TEXT : HOME : PRINT  CHR$(4)"RUNMENU"
  58. 7000 I = CU +35: HCOLOR= 7: DRAW 53 AT X(I) +12,Y(I): RETURN 
  59. 7500 I = OC +35: HCOLOR= 4: DRAW 53 AT X(I) +12,Y(I): RETURN 
  60. 8000  HOME : PRINT : PRINT "<CTRL-G>THE "C$(V(I))" DOESN'T GO ON THE "C$(V(0))"!<CTRL-G>"
  61. 8130  FOR P = 1 TO 3000: NEXT : GOTO 400
  62. 9000 K = 0: FOR I = 1 TO 7:K = K +V(I): NEXT : IF K < >0  THEN  GOTO 400
  63. 9060  HOME : VTAB 21: PRINT "<CTRL-G>Y<CTRL-G>O<CTRL-G>U<CTRL-G> <CTRL-G>W<CTRL-G>I<CTRL-G>N<CTRL-G> <CTRL-G><CTRL-J>AND STILL HAD "C1" CARDS TO PLAY!": GOTO 6025
  64. 9500 TL = 0:SP = 0: FOR I = 1 TO 7: FOR J = 5 TO 1  STEP  -1:JI = 7 *(J -1) +I: IF V(JI) < >0  THEN TL = TL +J:J = 1: IF V(JI) = V(0) +1  OR V(JI) = V(0) -1  THEN SP = 1:I = 7
  65. 9510  NEXT : NEXT 
  66. 9520  IF SP = 1  THEN  RETURN 
  67. 9600  POP : HOME : VTAB 21: PRINT "YOU LEFT ";: FOR N = 1 TO TL: HTAB 10: PRINT N;: CALL 768: FOR W = 1 TO 500: NEXT : NEXT : PRINT " CARDS!      <CTRL-J>     YOU LOSE!": GOTO 6025
  68. 20000  TEXT : HOME 
  69. 20010  PRINT "THE DECK IS SHUFFLED AND DEALT FACE UP  IN 7 VERTICAL COLUMNS OF 5 CARDS EACH.": PRINT "THE NEXT CARD IS THEN DEALT,FACE UP,    UNDER THESE CARDS TO START THE PILE."
  70. 20015  PRINT 
  71. 20020  PRINT "THE OBJECT OF THE GAME IS TO TRANSFER   ALL THE CARDS IN THE SEVEN COLUMNS TO   THE OUTPUT PILE.": PRINT "ONLY THE CARDS AT THE BOTTOM OF EACH    COLUMN IS PLAYABLE"
  72. 20030  PRINT "A CARD CAN BE PLAYED TO THE OUTPUT FILE IF IT IS ONE NUMBER HIGHER OR ONE NUMBERLOWER THAN THE FILE CARD.": INVERSE : PRINT "SUITS ARE IGNORED AND THE ACE EQUALS ONE": NORMAL 
  73. 20040  PRINT "IF A CARD CANNOT BE PLAYED TO THE FILE, THEN A CARD IS DEALT FROM DECK TO THE   FILE.": PRINT "IF THERE ARE NO CARDS LEFT IN THE DECK  THEN YOU LOSE."
  74. 20050  VTAB 24: PRINT "PRESS ANY KEY TO START";: WAIT 49152,128: POKE 49168,0: PRINT : RETURN 
  75. 30000  FOR I = 1 TO 13: READ C$(I): NEXT 
  76. 30010  DATA  ACE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE,TEN,JACK,QUEEN,KING
  77. 30020  FOR I = 768 TO 789: READ J: POKE I,J: NEXT : DATA  160,1,162,0,138,24,233,1,208,252,141,48,192,232,224,125,208,242,136,208,237,96 
  78. 30100  FOR X1 = 0 TO 2: FOR X2 = 0 TO 1: FOR X3 = 0 TO 6:I = 1 +X3 +7 *X2 +14 *X1:X(I) = 12 +32 *X3:Y(I) = 10 +15 *(2 *X1 +X2) +30 *(X1 = 2) *(X2 = 1): NEXT : NEXT : NEXT :X(0) = 120:Y(0) = 123
  79. 30110  FOR J = 1 TO 52:DK(J) = J: NEXT 
  80. 31000  RETURN 
  81. 49000  WAIT 49152,128
  82. 50000  END 
  83. 59999  REM       ADAPTED FROM            ** ONE FOUNDATION **       - BY PAUL M. ZELMAN -
  84. 60000  REM <CTRL-J><CTRL-J>COMPLETELY REWRITTEN               5/18/83                  BOB RAGSDALE<CTRL-J><CTRL-J>
  85. 60666  REM         <CTRL-J><CTRL-J>F<CTRL-J><CTRL-J>